home *** CD-ROM | disk | FTP | other *** search
/ TPUG - Toronto PET Users Group / TPUG Users Group CD / TPUG Users Group CD.iso / C64 / A-Monthly Disks / (c)aas.d64 / dbmanager (.txt) < prev    next >
Commodore BASIC  |  2007-02-04  |  13KB  |  524 lines
  1. 1 PRINT"[147]     [158] DATABASE MANAGER [146]"
  2. 2 REM DATABASE MANAGER WITH RELATIVE FILES: TREVOR JONES 05/31/86
  3. 3 PRINT"         [158]TREVOR JONES 05/31/86"
  4. 4 REM ** MAIN MENU **
  5. 5 PRINT"[158]     USING COMMODORE RELATIVE FILES     [146]":FOR I=1 TO 300
  6. 6 IF INT(I/3)=I/3 THEN POKE53280,INT(RND(0)*10)
  7. 7 NEXT I:PRINT"[147]":CLR
  8. 8 PRINT TAB(10)"[158]DATABASE MANAGER"
  9. 9 PRINT TAB(15)" 0-FORMAT NEW DISK   "
  10. 10 PRINT TAB(15)" 1-CREATE NEW FILE  "
  11. 12 PRINT TAB(15)" 2-ADD TO A FILE    "
  12. 14 PRINT TAB(15)" 3-VIEW FILE (PRINT,"
  13. 16 PRINT TAB(15)"   SEARCH AND SORT) "
  14. 18 PRINT TAB(15)" 4-DELETE A FILE    "
  15. 20 PRINT TAB(15)" 5-DELETE A RECORD  "
  16. 22 PRINT TAB(15)" 6-FILE FORMAT      "
  17. 23 PRINT TAB(15)" 7-CORRECTIONS      "
  18. 24 PRINT TAB(15)" 8-QUIT             "
  19. 26 PRINT TAB(5)"CHOOSE OPTION, ENTER NUMBER"
  20. 28 GET A$:IF A$="" THEN 28
  21. 30 A=VAL(A$)
  22. 31 IF A=0 THEN GOSUB 11000
  23. 32 IF A<1 OR A>8 THEN 6
  24. 34 ON A GOSUB 100,204,300,580,690,610,800,38
  25. 36 GOTO 5
  26. 38 PRINT"[147] ARE YOU FINISHED (Y/N)? "
  27. 40 GET E$:IF E$="" THEN 40
  28. 42 IF E$="N" THEN 5
  29. 44 PRINT"  ALL DONE!!   "
  30. 46 END
  31. 100 REM ** CREATE ROUTINE **
  32. 102 PRINT "[147]"
  33. 104 PRINT"CREATE A NEW FILE":PRINT"MUST ENTER AT LEAST ONE RECORD."
  34. 106 PRINT"PRESS RETURN[146] TO CONTINUE OR Q[146] FOR MENU"
  35. 107 GET C$:IF C$="" THEN 107
  36. 108 IF C$="Q" THEN RETURN
  37. 110 PRINT"[147]A RECORD IS MADE UP OF A NUMBER"
  38. 112 PRINT"OF FIELDS."
  39. 114 INPUT"HOW MANY FIELDS PER RECORD";NF
  40. 116 DIM L(NF),PZ(NF),D$(NF),T$(NF)
  41. 118 RL=0
  42. 120 FOR N=1 TO NF
  43. 122 PRINT"[147]":PRINT"LENGTH OF FIELD #";N
  44. 124 INPUT L(N)
  45. 126 RL=RL+L(N)
  46. 128 PZ(N)=RL-(L(N)-1)
  47. 129 PRINT"NAME OF FIELD (9 CHARACTERS OR LESS)"
  48. 130 INPUT T$(N):NEXT N
  49. 132 PRINT"[147]TO REVIEW YOUR FILE SET-UP ENTER R[146],"
  50. 134 PRINT"ELSE ENTER RETURN[146]."
  51. 136 GET REV$:IF REV$="" THEN 136
  52. 138 IF REV$<>"R" THEN 154
  53. 140 PRINT"[147]    SET-UP [146]"
  54. 142 PRINT TAB(10)"RECORD LENGTH:";TAB(8);RL
  55. 144 FOR N=1 TO NF
  56. 146 PRINT TAB(10)"POSITION FOR FIELD ";N;": ";PZ(N)
  57. 148 PRINT TAB(5)"LENGTH = ";L(N);"  NAME ";T$(N)
  58. 150 NEXT N:PRINT"ENTER S[146] TO START OVER"
  59. 152 PRINT"ENTER RETURN[146] TO CONTINUE":INPUT C$
  60. 153 IF C$="S" THEN 100
  61. 154 PRINT"[147]":PRINT"ENTER FILE NAME (UP TO 6 CHARACTERS)":INPUT F$
  62. 156 OPEN2,8,2,"0:"+F$+".PTR,S,W"
  63. 158 PTR=0:RN=PTR
  64. 160 PRINT#2,PTR
  65. 162 PRINT#2,RL
  66. 164 PRINT#2,NF
  67. 166 FOR N=1 TO NF
  68. 168 PRINT#2,PZ(N)
  69. 169 PRINT#2,T$(N)
  70. 170 NEXT N:CLOSE2
  71. 172 GOSUB 1000
  72. 176 RN=RN+1:GOSUB 8000:I=RN
  73. 188 GOSUB 2000
  74. 190 GOSUB 3000
  75. 192 PRINT"[147]ANOTHER RECORD (Y/N)?"
  76. 194 GET A$:IF A$="" THEN 194
  77. 196 IF A$="Y" THEN 172
  78. 198 PRINT"    CLOSING FILES...."
  79. 199 PTR=RN
  80. 200 GOSUB 4000
  81. 202 RETURN
  82. 204 REM ** ADDITION ROUTINE **
  83. 206 PRINT"[147] ADD TO OLD FILE "
  84. 208 PRINT"PRESS RETURN[146] TO CONTINUE OR Q[146] FOR MENU"
  85. 209 GET C$:IF C$="" THEN 209
  86. 210 IF C$="Q" THEN RETURN
  87. 211 PRINT"[147]ENTER D[146]IRECTORY OR RETURN[146] TO CONTINUE"
  88. 212 GET A$:IF A$="D" THEN GOSUB 10000
  89. 213 IF A$="" THEN 212
  90. 214 PRINT"[147] FILE NAME FOR ADDITION "
  91. 216 INPUT F$
  92. 218 PRINT"[147]     ONE MOMENT...."
  93. 220 GOSUB 5000
  94. 222 GOSUB 1000
  95. 224 RN=PTR+1:GOSUB 8000:I=RN:PTR=RN
  96. 226 GOSUB 2000
  97. 228 GOSUB 3000
  98. 230 PRINT"[147]ANOTHER RECORD (Y/N)?"
  99. 232 GET A$:IF A$="" THEN 232
  100. 234 IF A$="Y" THEN 222
  101. 236 PRINT"   CLOSING FILES...."
  102. 238 GOSUB 4000
  103. 240 RETURN
  104. 300 REM ** VIEW FILE ROUTINE **
  105. 302 PRINT"[147] VIEW FILE - SEARCH, SORT AND PRINT ":X=0:T=0
  106. 304 PRINT"PRESS RETURN[146] TO CONTINUE OR Q[146] FOR MENU"
  107. 305 GET C$:IF C$="" THEN 305
  108. 306 IF C$="Q" THEN RETURN
  109. 307 PRINT"[147]ENTER D[146]IRECTORY OR RETURN[146] TO CONTINUE"
  110. 308 GET A$:IF A$="" THEN 308
  111. 309 IF A$="D" THEN GOSUB 10000
  112. 310 PRINT"[147] NAME OF FILE FOR VIEWING? "
  113. 312 INPUT F$
  114. 314 GOSUB 5000
  115. 316 PRINT"[147] VIEW MENU "
  116. 318 PRINT TAB(5)" 1-TOTAL FILE          "
  117. 320 PRINT TAB(5)" 2-INDIVIDUAL RECORD   "
  118. 322 PRINT TAB(5)" 3-SEARCH              "
  119. 324 PRINT TAB(5)" 4-SORT                "
  120. 326 PRINT TAB(5)" 5-RETURN TO MAIN MENU "
  121. 328 PRINT"CHOOSE OPTION, ENTER NUMBER"
  122. 330 GET A$:IF A$="" THEN 330
  123. 331 IF VAL(A$)<1ORVAL(A$)>5 THEN 316
  124. 332 IF VAL(A$)=5 THEN RETURN
  125. 334 ON VAL(A$) GOSUB 338,388,426,524
  126. 336 GOTO 316
  127. 338 PRINT"[147]REVIEW ENTIRE FILE ";F$;"[146]"
  128. 340 PRINT"GETTING FILE, PLEASE WAIT..."
  129. 342 FOR I=1 TO PTR
  130. 344 GOSUB 1000
  131. 346 RN=I:GOSUB 8000
  132. 348 GOSUB 6000
  133. 352 GOSUB 3000
  134. 356 PRINT"[147]RECORD #";I
  135. 358 FOR N=1 TO NF
  136. 360 PRINT N;":";T$(N);":";D$(N)
  137. 362 NEXT N
  138. 364 PRINT"ENTER C[146] TO CONTINUE, Q[146] TO QUIT"
  139. 365 PRINT"OR P[146] TO PRINT ENTIRE FILE"
  140. 366 GET A$:IF A$="" THEN 366
  141. 368 IF A$="Q" THEN N=NF:I=PTR:RETURN
  142. 369 IF A$="P" THEN N=NF:I=PTR:GOTO 379
  143. 370 NEXT I
  144. 372 PRINT"[147]END OF FILE";SPC(2);PTR;" RECORDS"
  145. 374 PRINT"DO YOU WANT A HARDCOPY (Y/N)?"
  146. 376 GET A$:IF A$="" THEN 376
  147. 378 IF A$="N" THEN RETURN
  148. 379 PRINT"[147]PRINTING ";PTR;" RECORDS OF FILE ";F$:GOSUB 1000
  149. 380 FOR I=1 TO PTR:RN=I:GOSUB 8000
  150. 381 GOSUB 6000
  151. 382 GOSUB 7000
  152. 384 NEXT I
  153. 385 GOSUB 3000
  154. 386 RETURN
  155. 388 PRINT"[147]REVIEW INDIVIDUAL RECORDS"
  156. 389 PRINT"THERE ARE ";PTR;" RECORDS."
  157. 390 INPUT"WHAT RECORD NUMBER";I
  158. 391 IF I>PTR THEN PRINT"[145][145][145]":GOTO 390
  159. 392 PRINT"GETTING RECORD...":FOR Q=1 TO 500:NEXT Q
  160. 394 RN=I:GOSUB 8000
  161. 396 GOSUB 1000
  162. 398 PRINT"[147]RECORD #";I
  163. 400 GOSUB 6000
  164. 402 GOSUB 3000
  165. 404 FOR N=1 TO NF
  166. 406 PRINT N;":";T$(N);":";D$(N)
  167. 408 NEXT N
  168. 410 PRINT"DO YOU WANT A HARDCOPY (Y/N)"
  169. 411 GET R$:IF R$="" THEN 411
  170. 412 IF R$="Y" THEN GOSUB 7000
  171. 414 PRINT"ANOTHER RECORD NUMBER?"
  172. 416 PRINT"ENTER RECORD NUMBER OR N[146]O"
  173. 418 INPUT A$:IF A$="" THEN 418
  174. 420 IF A$="N" THEN RETURN
  175. 422 I=VAL(A$):GOTO 392
  176. 424 RETURN
  177. 426 REM ** SEARCH **
  178. 428 PRINT"[147]  SEARCH  ":DIM GS(PTR)
  179. 430 PRINT"FIND RECORDS WITH COMMON FIELDS"
  180. 432 PRINT"ENTIRE FIELD IS NOT NECESSARY"
  181. 436 PRINT"ENTER RETURN[146] TO CONTINUE OR Q[146] FOR MENU"
  182. 437 GET C$:IF C$="" THEN 437
  183. 438 IF C$="Q" THEN RETURN
  184. 440 PRINT"[147]"TAB(10)"LIST OF FIELDS AND TITLES"
  185. 442 FOR N=1 TO NF
  186. 444 PRINT TAB(10)"FIELD ";N;": ";T$(N)
  187. 446 NEXT N
  188. 448 INPUT"ENTER FIELD NUMBER TO SEARCH";I:P=I
  189. 450 IF I>NF THEN 440
  190. 452 SF=PZ(I)
  191. 454 PRINT"[147]ENTER COMMON ITEM FOR SEARCH"
  192. 456 INPUT CS$:NR=PTR
  193. 458 GOSUB 1000
  194. 460 K=0
  195. 462 FOR I=1 TO NR
  196. 464 PRINT"[147] SEARCHING RECORD #";I
  197. 466 RN=I:GOSUB 8000
  198. 468 PRINT#15,"P";CHR$(3);CHR$(RI);CHR$(RH);CHR$(SF)
  199. 470 INPUT#3,D$
  200. 471 S=LEN(CS$):L=LEN(D$)
  201. 472 FOR N=1 TO L-S+1:IF CS$=MID$(D$,N,S) THEN N=L-S+1:K=K+1:GS(K)=I
  202. 473 NEXT N
  203. 476 NEXT I:GOSUB 3000
  204. 478 PRINT"[147]THE FOLLOWING RECORDS WERE FOUND":CK=0:PT=0
  205. 480 FOR I=1 TO K-1
  206. 482 PRINT GS(I);",";:NEXT I:PRINT GS(K):PRINT
  207. 484 PRINT"CHOOSE NUMBER TO VIEW OR A[146]LL"
  208. 485 PRINT "ENTER P[146] FOR HARDCOPY OR Q[146] FOR MENU"
  209. 486 INPUT A$:IF A$="Q" THEN RETURN
  210. 487 IF A$="P" THEN 500
  211. 488 IF A$<>"A" THEN 502
  212. 490 FOR L=1 TO K:CK=1
  213. 491 I=GS(L)
  214. 492 RN=GS(L):GOSUB 8000
  215. 494 GOSUB 503
  216. 495 IF A$="P" THEN 497
  217. 496 PRINT"PRESS RETURN[146] TO CONTINUE":INPUT R$
  218. 497 NEXT L:PRINT"ENTER P[146] FOR A HARDCOPY OF ALL"
  219. 498 PRINT"ENTER RETURN[146] TO CONTINUE"
  220. 499 GET A$:IF A$="" THEN 499
  221. 500 IF A$="P" THEN PT=1:GOTO 490
  222. 501 IF A$=CHR$(13) THEN 478
  223. 502 RN=VAL(A$):GOSUB 8000:I=RN
  224. 503 GOSUB 1000
  225. 504 GOSUB 6000
  226. 506 GOSUB 3000
  227. 507 IFPT=1THENOPEN4,4:PRINT#4:PRINT#4,"SEARCH FIELD '";T$(P);"' FOR ";CS$
  228. 508 IF PT=1 THEN PRINT#4:CLOSE4:PT=2
  229. 509 IF PT=2 THEN GOSUB 7000:RETURN
  230. 510 PRINT"[147] RECORD #";RN
  231. 511 FOR N=1 TO NF
  232. 512 PRINT"FIELD #";N;":";T$(N);":";D$(N)
  233. 514 NEXT N:IF CK=1 THEN RETURN
  234. 516 PRINT"ENTER C[146] TO CONTINUE OR Q[146] FOR MENU"
  235. 517 PRINT"ENTER P[146] FOR HARDCOPY"
  236. 518 GET B$:IF B$="" THEN 518
  237. 520 IF B$="C" THEN 478
  238. 521 IF B$="P" THEN GOSUB 7000:GOTO 478
  239. 522 RETURN
  240. 524 REM ** SORT ROUTINE **
  241. 525 PRINT"[147] SORT FILES [146]"
  242. 526 PRINT" THIS SORTS THE FILES ON THE DISK AND IS SLOW! ENOUGH TIME FOR";
  243. 527 PRINT" LUNCH AND DINNER. THIS IS NOT NECESSARY WITH RANDOM FILES"
  244. 528 PRINT" BUT IF YOU MUST....     [146][158]":PRINT"ENTER RETURN[146] TO CONTINUE"
  245. 529 PRINT"[158]OR Q[146] FOR VIEW MENU"
  246. 530 GET A$:IF A$="" THEN 530
  247. 531 IF A$="Q" THEN 316
  248. 532 PRINT"[147]CHOOSE ONE OF THE FOLLOWING FIELD"
  249. 533 PRINT"NUMBERS FOR THE ASCENDING SORT"
  250. 534 FOR N=1 TO NF:PRINT N;T$(N):NEXT N
  251. 535 PRINT
  252. 536 INPUT"WHICH FIELD NUMBER";SF
  253. 537 PRINT"[147]SORTING.........."
  254. 538 S=0:F=1:L=PTR:DIM M$(NF),A$(NF),B$(NF),DT$(PTR,NF):GOSUB 1000
  255. 539 FOR I=1 TO PTR:RN=I:GOSUB 8000:GOSUB 6000
  256. 540 FOR N=1 TO NF:DT$(I,N)=D$(N):NEXT N
  257. 541 NEXT I:GOSUB 3000
  258. 542 RN=INT((L+F)/2)
  259. 543 FOR N=1 TO NF:M$(N)=DT$(RN,N):NEXT N
  260. 544 I=F:J=L
  261. 545 A$(SF)=DT$(I,SF)
  262. 546 IF A$(SF)<M$(SF) THEN I=I+1:GOTO545
  263. 547 B$(SF)=DT$(J,SF)
  264. 548 IF B$(SF)>M$(SF) THEN J=J-1:GOTO547
  265. 549 IF I>J THEN 559
  266. 550 IF I=J THEN 557
  267. 551 FOR N=1 TO NF:A$(N)=DT$(I,N):B$(N)=DT$(J,N)
  268. 552 TEMP$=A$(N)
  269. 553 A$(N)=B$(N)
  270. 554 B$(N)=TEMP$
  271. 555 NEXT N
  272. 556 FOR K=1 TO NF:DT$(I,K)=A$(K):DT$(J,K)=B$(K):NEXT K
  273. 557 I=I+1:J=J-1
  274. 558 IF I<=J THEN 545
  275. 559 IF I>=L THEN 561
  276. 560 F(S)=I:L(S)=L:S=S+1
  277. 561 L=J:IF F<L THEN 542
  278. 562 IF S=0 THEN 564
  279. 563 S=S-1:F=F(S):L=L(S):GOTO 542
  280. 564 GOSUB 1000
  281. 565 FOR I=1 TO PTR:RN=I:GOSUB 8000
  282. 566 FOR N=1 TO NF
  283. 567 D$(N)=DT$(I,N)
  284. 568 NEXT N:GOSUB 9100
  285. 569 NEXT I:GOSUB 3000
  286. 571 RETURN
  287. 580 REM ** FILE DELETION **
  288. 582 PRINT"[147] FILE DELETION [146]"
  289. 584 PRINT"PRESS RETURN[146] TO CONTINUE OR Q[146] FOR MENU"
  290. 585 GET C$:IF C$="" THEN 585
  291. 586 IF C$="Q" THEN RETURN
  292. 588 PRINT"[147] ENTER FILE TO BE DELETED "
  293. 590 INPUT F$
  294. 592 PRINT"ARE YOU SURE (Y/N)?"
  295. 594 PRINT"-------------------"
  296. 596 GET A$:IF A$="" THEN 596
  297. 598 IF A$="N" THEN RETURN
  298. 600 PRINT"[147] DELETING FILES ASSOCIATED WITH ";F$
  299. 602 OPEN15,8,15
  300. 604 PRINT#15,"S0:"+F$+".*"
  301. 606 CLOSE 15
  302. 608 RETURN
  303. 610 REM ** FORMAT ROUTINE **
  304. 614 PRINT"[147]"TAB(10)" FORMAT MENU "
  305. 618 PRINT TAB(15)" 1-REVIEW FORMAT       "
  306. 620 PRINT TAB(15)" 2-RETURN TO MAIN MENU "
  307. 626 PRINT"CHOOSE OPTION, ENTER NUMBER"
  308. 628 GET A$:IF A$="" THEN 628
  309. 630 ON VAL(A$) GOSUB 664,632
  310. 632 RETURN
  311. 664 PRINT"[147]ENTER FILE NAME"
  312. 666 INPUT F$:PRINT"[147]   GETTING DATA..."
  313. 668 OPEN2,8,2,"0:"+F$+".PTR,S,R"
  314. 670 INPUT#2,PTR,RL,NF
  315. 671 DIM T$(NF),PZ(NF)
  316. 672 FOR N=1 TO NF
  317. 674 INPUT#2,PZ(N),T$(N)
  318. 676 NEXT N:CLOSE2
  319. 678 PRINT"[147]  FORMAT FOR ";F$
  320. 680 FOR N=1 TO NF
  321. 682 PRINT TAB(5)"FIELD ";N;":";T$(N);"  POSITION ";PZ(N)
  322. 684 NEXT N
  323. 686 PRINT"ENTER RETURN[146] TO CONTINUE":INPUT R$
  324. 688 RETURN
  325. 690 REM ** RECORD DELETION **
  326. 692 PRINT"[147] RECORD DELETION "
  327. 694 PRINT"ENTER RETURN[146] TO CONTINUE OR Q[146] FOR MENU"
  328. 696 GET A$:IF A$="" THEN 696
  329. 698 IF A$="Q" THEN RETURN
  330. 700 PRINT"[147] NAME OF FILE TO ACCESS? "
  331. 702 INPUT F$
  332. 704 GOSUB 5000
  333. 706 PRINT"[147]THERE ARE ";PTR;" RECORDS."
  334. 708 PRINT"ENTER THE RECORD NUMBER TO DELETE."
  335. 710 INPUT DN:IF DN>PTR THEN 706
  336. 712 RN=DN:GOSUB 8000:I=DN
  337. 714 GOSUB 1000
  338. 716 GOSUB 6000
  339. 718 GOSUB 3000
  340. 719 PRINT"[147]RECORD #";I:PRINT
  341. 720 FOR N=1 TO NF
  342. 722 PRINT N;":";D$(N)
  343. 724 NEXT N
  344. 726 PRINT"IS THIS THE RECORD TO DELETE (Y/N)?"
  345. 728 GET A$:IF A$="" THEN 728
  346. 730 IF A$="N" THEN PRINT"[147]TRY AGAIN!":GOTO 706
  347. 732 PRINT"ARE YOU SURE (Y/N)?"
  348. 734 GET A$:IF A$="" THEN 734
  349. 736 IF A$="N" THEN RETURN
  350. 738 PRINT"[147]DELETING RECORD AND PACKING..."
  351. 740 GOSUB 1000
  352. 742 FOR I=DN+1 TO PTR
  353. 744 RN=I:GOSUB 8000
  354. 746 GOSUB 6000
  355. 748 RN=I-1:GOSUB 8000
  356. 750 GOSUB 9100
  357. 752 NEXT I
  358. 754 GOSUB 3000
  359. 756 PTR=PTR-1
  360. 758 PRINT"[147]ANOTHER RECORD FOR DELETION (Y/N)?"
  361. 760 GET A$:IF A$="" THEN 760
  362. 762 IF A$="Y" THEN 706
  363. 764 GOSUB 4000
  364. 766 RETURN
  365. 800 PRINT"[147]CORRECTIONS TO FIELD IN A RECORD"
  366. 802 PRINT"PRESS RETURN[146] TO CONTINUE OR Q[146] FOR MENU"
  367. 803 GET C$:IF C$="" THEN 803
  368. 804 IF C$="Q" THEN RETURN
  369. 806 INPUT"[147]NAME OF FILE FOR CORRECTION";F$
  370. 808 GOSUB 5000
  371. 810 PRINT"[147]THERE ARE ";PTR;" RECORDS"
  372. 812 PRINT"ENTER RECORD NUMBER FOR CORRECTION"
  373. 813 INPUT"OR Q[146] FOR MENU";RC$
  374. 814 IF RC$="Q" THEN RETURN
  375. 815 RN=VAL(RC$):GOSUB 8000
  376. 816 GOSUB 1000
  377. 818 GOSUB 6000:GOSUB 3000
  378. 820 PRINT"[147]":FOR N=1 TO NF
  379. 822 PRINT"FIELD #";N;" ";T$(N);":";D$(N)
  380. 824 NEXT N
  381. 825 PRINT"ENTER FIELD NUMBER FOR CORRECTION":PRINT"OR N[146] FOR NEXT"
  382. 826 PRINT"OR OK[146] TO SAVE":INPUT N$
  383. 827 IF LEFT$(N$,1)="O" THEN 836
  384. 828 AX=VAL(N$):IF N$="N" THEN 810
  385. 829 PRINT"[147]FIELD #";AX;" ";T$(AX);":";D$(AX)
  386. 830 PRINT"ENTER NEW FIELD"
  387. 832 INPUT D$(AX)
  388. 834 GOTO 820
  389. 836 FOR N=1 TO NF:I=RN
  390. 838 SW$(I,N)=D$(N)
  391. 840 NEXT N
  392. 841 PRINT"[147]CORRECTING RECORD N0.";RN
  393. 842 GOSUB 1000:GOSUB 9000:GOSUB 3000
  394. 844 GOTO 810
  395. 1000 REM ** OPEN .DBF **
  396. 1002 OPEN15,8,15
  397. 1004 OPEN3,8,3,F$+".DBF,L,"+CHR$(RL)
  398. 1006 RETURN
  399. 2000 REM ** ENTER .DBF DATA **
  400. 2001 FOR N=1 TO NF
  401. 2002 PRINT"[147]RECORD #";I
  402. 2003 PRINT"ENTER DATA FOR FIELD #";N;":";T$(N)
  403. 2004 D$(N)="":INPUT D$(N):IF D$(N)="" THEN D$(N)="*"
  404. 2005 PRINT#15,"P";CHR$(3);CHR$(RI);CHR$(RH);CHR$(PZ(N))
  405. 2006 PRINT#3,D$(N)
  406. 2008 NEXT N
  407. 2010 RETURN
  408. 3000 REM ** CLOSE .DBF **
  409. 3002 CLOSE3
  410. 3004 CLOSE15
  411. 3006 RETURN
  412. 4000 REM ** REWRITE .PTR **
  413. 4002 OPEN2,8,2,"@0:"+F$+".PTR,S,W"
  414. 4004 PRINT#2,PTR
  415. 4006 PRINT#2,RL
  416. 4008 PRINT#2,NF
  417. 4010 FOR N=1 TO NF
  418. 4012 PRINT#2,PZ(N):PRINT#2,T$(N)
  419. 4014 NEXT N
  420. 4016 CLOSE2
  421. 4018 RETURN
  422. 5000 REM ** READ .PTR **
  423. 5002 OPEN2,8,2,"0:"+F$+".PTR,S,R"
  424. 5004 INPUT#2,PTR,RL,NF
  425. 5006 DIM PZ(NF),D$(NF),TEMP$(NF),SW$(PTR,NF),T$(NF)
  426. 5008 FOR N=1 TO NF
  427. 5010 INPUT#2,PZ(N),T$(N)
  428. 5012 NEXT N
  429. 5014 CLOSE2
  430. 5016 RETURN
  431. 6000 REM ** READ .DBF **
  432. 6002 FOR N=1 TO NF
  433. 6004 PRINT#15,"P";CHR$(3);CHR$(RI);CHR$(RH);CHR$(PZ(N))
  434. 6006 INPUT#3,D$(N)
  435. 6008 NEXT N
  436. 6010 RETURN
  437. 7000 REM ** PRINT ROUTINE **
  438. 7002 OPEN4,4
  439. 7004 PRINT#4,"RECORD #";I:GOSUB 7020
  440. 7006 FOR N=1 TO NF
  441. 7007 S=10-LEN(T$(N))
  442. 7008 PRINT#4,N;":";T$(N);":";SPC(S);D$(N):GOSUB 7020
  443. 7010 NEXT N
  444. 7012 PRINT#4:T=T+1:CLOSE4
  445. 7014 RETURN
  446. 7020 T=T+1
  447. 7022 IF T>=59 THEN T=0:FOR K=1 TO 4:PRINT#4,CHR$(13):NEXT K
  448. 7024 RETURN
  449. 8000 REM ** RECORD NUMBER ROUTINE **
  450. 8002 RI=RN
  451. 8004 RH=0
  452. 8006 IF RI>255 THEN 8010
  453. 8008 RETURN
  454. 8010 RH=INT(RI/256)
  455. 8012 RI=RI-256*RH
  456. 8014 RETURN
  457. 9000 REM ** REWRITE .DBF DATA **
  458. 9002 FOR N= 1 TO NF
  459. 9004 PRINT#15,"P";CHR$(3);CHR$(RI);CHR$(RH);CHR$(PZ(N))
  460. 9006 PRINT#3,SW$(I,N)
  461. 9008 NEXT N
  462. 9010 RETURN
  463. 9100 REM ** ANOTHER WRITE .DBF **
  464. 9101 FOR N=1 TO NF
  465. 9102 PRINT#15,"P";CHR$(3);CHR$(RI);CHR$(RH);CHR$(PZ(N))
  466. 9104 PRINT#3,D$(N)
  467. 9106 NEXT N
  468. 9108 RETURN
  469. 10000 REM ** DISK ROUTINE **
  470. 10002 OPEN2,8,15
  471. 10004 PRINT"[147]":GOTO 10068
  472. 10006 OPEN1,8,0,"$0"
  473. 10008 GET#1,A$,B$
  474. 10010 GET#1,A$,B$
  475. 10012 GET#1,A$,B$
  476. 10014 C=0
  477. 10016 IF A$<>"" THEN C=ASC(A$)
  478. 10018 IF B$<>"" THEN C=C+ASC(B$)*256
  479. 10020 PRINT""MID$(STR$(C),2);TAB(3);"[146]"
  480. 10022 GET#1,B$:IF ST<>0 THEN 10040
  481. 10024 IF B$<>CHR$(34) THEN 10022
  482. 10026 GET#1,B$:IF B$<>CHR$(34) THEN PRINT B$;:GOTO 10026
  483. 10028 GET#1,B$:IF B$=CHR$(32) THEN 10028
  484. 10030 PRINT TAB(18);:C$=""
  485. 10032 C$=C$+B$:GET#1,B$:IF B$<>"" THEN 10032
  486. 10034 PRINT""LEFT$(C$,3)
  487. 10036 GET T$:IF T$<>"" THEN GOSUB 10044:IF T$="Q" THEN 10088
  488. 10038 IF ST=0 THEN 10010
  489. 10040 PRINT" BLOCKS FREE"
  490. 10042 CLOSE1:GOTO 10068
  491. 10044 IF T$="Q" THEN CLOSE1:RETURN
  492. 10046 GET T$:IF T$="" THEN 10044
  493. 10048 RETURN
  494. 10050 REM DISK COMMAND
  495. 10052 C$="":PRINT">";
  496. 10054 GET B$:IF B$="" THEN 10054
  497. 10056 PRINT B$;:IF B$=CHR$(13) THEN 10060
  498. 10058 C$=C$+B$:GOTO 10054
  499. 10060 PRINT#2,C$
  500. 10062 PRINT"";
  501. 10064 GET#2,A$:PRINT A$;:IF A$<>CHR$(13) GOTO 10064
  502. 10066 PRINT"[146]"
  503. 10068 PRINT "D-DIRECTORY"
  504. 10072 PRINT "Q-QUIT DISK ROUTINE"
  505. 10074 PRINT "S-DISK STATUS"
  506. 10075 PRINT""
  507. 10076 GET A$:IF A$="" THEN 10076
  508. 10078 IF A$="D" THEN 10006
  509. 10082 IF A$="Q" THEN 10088
  510. 10084 IF A$="S" THEN 10062
  511. 10086 GOTO 10076
  512. 10088 CLOSE2:RETURN
  513. 11000 REM ** FORMAT NEW DISK ROUTINE **
  514. 11002 PRINT"[147] FORMAT NEW DISK [146]"
  515. 11004 PRINT"ARE YOU SURE, FORMATTING ERASES DISK!"
  516. 11006 PRINT" Y[146]ES OR N[146]O? "
  517. 11008 GET A$:IF A$="" THEN 11008
  518. 11010 IF A$="N" THEN RETURN
  519. 11012 INPUT"[147]WHAT IS DISK NAME";DN$
  520. 11014 INPUT"WHAT IS THE UNIQUE DISK NUMBER";UN
  521. 11016 OPEN15,8,15
  522. 11018 PRINT#15,"N0:"+DN$+","+STR$(UN)
  523. 11020 CLOSE15:RETURN
  524.